home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_emacs.idb / usr / freeware / share / emacs / 19.34 / lisp / gnus-ems.el.z / gnus-ems.el
Encoding:
Text File  |  1998-10-28  |  8.0 KB  |  243 lines
  1. ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
  2. ;; Copyright (C) 1995,96 Free Software Foundation, Inc.
  3.  
  4. ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
  5. ;; Keywords: news
  6.  
  7. ;; This file is part of GNU Emacs.
  8.  
  9. ;; GNU Emacs is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; GNU Emacs is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ;; GNU General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22. ;; Boston, MA 02111-1307, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;;; Code:
  27.  
  28. (eval-when-compile (require 'cl))
  29.  
  30. (defvar gnus-mouse-2 [mouse-2])
  31.  
  32. (defalias 'gnus-make-overlay 'make-overlay)
  33. (defalias 'gnus-overlay-put 'overlay-put)
  34. (defalias 'gnus-move-overlay 'move-overlay)
  35. (defalias 'gnus-overlay-end 'overlay-end)
  36. (defalias 'gnus-extent-detached-p 'ignore)
  37. (defalias 'gnus-extent-start-open 'ignore)
  38. (defalias 'gnus-set-text-properties 'set-text-properties)
  39. (defalias 'gnus-group-remove-excess-properties 'ignore)
  40. (defalias 'gnus-topic-remove-excess-properties 'ignore)
  41. (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
  42. (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
  43. (defalias 'gnus-make-local-hook 'make-local-hook)
  44. (defalias 'gnus-add-hook 'add-hook)
  45. (defalias 'gnus-character-to-event 'identity)
  46. (defalias 'gnus-add-text-properties 'add-text-properties)
  47. (defalias 'gnus-put-text-property 'put-text-property)
  48. (defalias 'gnus-mode-line-buffer-identification 'identity)
  49.  
  50.  
  51. (eval-and-compile 
  52.   (autoload 'gnus-xmas-define "gnus-xmas")
  53.   (autoload 'gnus-xmas-redefine "gnus-xmas")
  54.   (autoload 'appt-select-lowest-window "appt.el"))
  55.  
  56. (or (fboundp 'mail-file-babyl-p)
  57.     (fset 'mail-file-babyl-p 'rmail-file-p))
  58.  
  59. ;;; Mule functions.
  60.  
  61. (defun gnus-mule-cite-add-face (number prefix face)
  62.   ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line.
  63.   (if face
  64.       (let ((inhibit-point-motion-hooks t)
  65.         from to)
  66.     (goto-line number)
  67.     (if (boundp 'MULE)
  68.         (forward-char (chars-in-string prefix))
  69.       (forward-char (length prefix)))
  70.     (skip-chars-forward " \t")
  71.     (setq from (point))
  72.     (end-of-line 1)
  73.     (skip-chars-backward " \t")
  74.     (setq to (point))
  75.     (if (< from to)
  76.         (gnus-overlay-put (gnus-make-overlay from to) 'face face)))))
  77.  
  78. (defun gnus-mule-max-width-function (el max-width)
  79.   (` (let* ((val (eval (, el)))
  80.         (valstr (if (numberp val)
  81.             (int-to-string val) val)))
  82.        (if (> (length valstr) (, max-width))
  83.        (truncate-string valstr (, max-width))
  84.      valstr))))
  85.  
  86. (eval-and-compile
  87.   (if (string-match "XEmacs\\|Lucid" emacs-version)
  88.       ()
  89.  
  90.     (defvar gnus-mouse-face-prop 'mouse-face
  91.       "Property used for highlighting mouse regions.")
  92.  
  93.     (defvar gnus-article-x-face-command
  94.       "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
  95.       "String or function to be executed to display an X-Face header.
  96. If it is a string, the command will be executed in a sub-shell
  97. asynchronously.     The compressed face will be piped to this command.")
  98.  
  99.     ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
  100.     (defvar gnus-display-type 
  101.       (condition-case nil
  102.       (let ((display-resource (x-get-resource ".displayType" "DisplayType")))
  103.         (cond (display-resource (intern (downcase display-resource)))
  104.           ((x-display-color-p) 'color)
  105.           ((x-display-grayscale-p) 'grayscale)
  106.           (t 'mono)))
  107.     (error 'mono))
  108.       "A symbol indicating the display Emacs is running under.
  109. The symbol should be one of `color', `grayscale' or `mono'. If Emacs
  110. guesses this display attribute wrongly, either set this variable in
  111. your `~/.emacs' or set the resource `Emacs.displayType' in your
  112. `~/.Xdefaults'. See also `gnus-background-mode'.
  113.  
  114. This is a meta-variable that will affect what default values other
  115. variables get.  You would normally not change this variable, but
  116. pounce directly on the real variables themselves.")
  117.  
  118.     (defvar gnus-background-mode 
  119.       (condition-case nil
  120.       (let ((bg-resource (x-get-resource ".backgroundMode"
  121.                          "BackgroundMode"))
  122.         (params (frame-parameters)))
  123.         (cond (bg-resource (intern (downcase bg-resource)))
  124.           ((and (cdr (assq 'background-color params))
  125.             (< (apply '+ (x-color-values
  126.                       (cdr (assq 'background-color params))))
  127.                (* (apply '+ (x-color-values "white")) .6)))
  128.            'dark)
  129.           (t 'light)))
  130.     (error 'light))
  131.       "A symbol indicating the Emacs background brightness.
  132. The symbol should be one of `light' or `dark'.
  133. If Emacs guesses this frame attribute wrongly, either set this variable in
  134. your `~/.emacs' or set the resource `Emacs.backgroundMode' in your
  135. `~/.Xdefaults'.
  136. See also `gnus-display-type'.
  137.  
  138. This is a meta-variable that will affect what default values other
  139. variables get.  You would normally not change this variable, but
  140. pounce directly on the real variables themselves."))
  141.  
  142.   (cond 
  143.    ((string-match "XEmacs\\|Lucid" emacs-version)
  144.     (gnus-xmas-define))
  145.  
  146.    ((or (not (boundp 'emacs-minor-version))
  147.     (< emacs-minor-version 30))
  148.     ;; Remove the `intangible' prop.
  149.     (let ((props (and (boundp 'gnus-hidden-properties) 
  150.               gnus-hidden-properties)))
  151.       (while (and props (not (eq (car (cdr props)) 'intangible)))
  152.     (setq props (cdr props)))
  153.       (and props (setcdr props (cdr (cdr (cdr props))))))
  154.     (or (fboundp 'buffer-substring-no-properties)
  155.     (defun buffer-substring-no-properties (beg end)
  156.       (format "%s" (buffer-substring beg end)))))
  157.    
  158.    ((boundp 'MULE)
  159.     (provide 'gnusutil))))
  160.  
  161. (eval-and-compile
  162.   (cond
  163.    ((not window-system)
  164.     (defun gnus-dummy-func (&rest args))
  165.     (let ((funcs '(mouse-set-point set-face-foreground
  166.                    set-face-background x-popup-menu)))
  167.       (while funcs
  168.     (or (fboundp (car funcs))
  169.         (fset (car funcs) 'gnus-dummy-func))
  170.     (setq funcs (cdr funcs))))))
  171.   (or (fboundp 'file-regular-p)
  172.       (defun file-regular-p (file)
  173.     (and (not (file-directory-p file))
  174.          (not (file-symlink-p file))
  175.          (file-exists-p file))))
  176.   (or (fboundp 'face-list)
  177.       (defun face-list (&rest args))))
  178.  
  179. (eval-and-compile
  180.   (let ((case-fold-search t))
  181.     (cond
  182.      ((string-match "windows-nt\\|os/2\\|emx" (format "%s" system-type))
  183.       (setq nnheader-file-name-translation-alist
  184.         (append nnheader-file-name-translation-alist
  185.             '((?: . ?_)
  186.               (?+ . ?-))))))))
  187.  
  188. (defvar gnus-tmp-unread)
  189. (defvar gnus-tmp-replied)
  190. (defvar gnus-tmp-score-char)
  191. (defvar gnus-tmp-indentation)
  192. (defvar gnus-tmp-opening-bracket)
  193. (defvar gnus-tmp-lines)
  194. (defvar gnus-tmp-name)
  195. (defvar gnus-tmp-closing-bracket)
  196. (defvar gnus-tmp-subject-or-nil)
  197.  
  198. (defun gnus-ems-redefine ()
  199.   (cond 
  200.    ((string-match "XEmacs\\|Lucid" emacs-version)
  201.     (gnus-xmas-redefine))
  202.  
  203.    ((boundp 'MULE)
  204.     ;; Mule definitions
  205.     (defalias 'gnus-truncate-string 'truncate-string)
  206.  
  207.     (fset 'gnus-summary-make-display-table (lambda () nil))
  208.     (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face)
  209.     (fset 'gnus-max-width-function 'gnus-mule-max-width-function)
  210.     
  211.     (if (boundp 'gnus-check-before-posting)
  212.     (setq gnus-check-before-posting
  213.           (delq 'long-lines
  214.             (delq 'control-chars gnus-check-before-posting))))
  215.  
  216.     (defun gnus-summary-line-format-spec ()
  217.       (insert gnus-tmp-unread gnus-tmp-replied 
  218.           gnus-tmp-score-char gnus-tmp-indentation)
  219.       (put-text-property
  220.        (point)
  221.        (progn
  222.      (insert 
  223.       gnus-tmp-opening-bracket 
  224.       (format "%4d: %-20s" 
  225.           gnus-tmp-lines 
  226.           (if (> (length gnus-tmp-name) 20) 
  227.               (truncate-string gnus-tmp-name 20) 
  228.             gnus-tmp-name))
  229.       gnus-tmp-closing-bracket)
  230.      (point))
  231.        gnus-mouse-face-prop gnus-mouse-face)
  232.       (insert " " gnus-tmp-subject-or-nil "\n"))
  233.     )))
  234.  
  235.  
  236. (provide 'gnus-ems)
  237.  
  238. ;; Local Variables:
  239. ;; byte-compile-warnings: '(redefine callargs)
  240. ;; End:
  241.  
  242. ;;; gnus-ems.el ends here
  243.